Clustering Mall Customers

#https://datatables.net/reference/option/
options(DT.options = list(scrollX = TRUE, pagin=TRUE, fixedHeader = TRUE, searchHighlight = TRUE))

Intro

Check out this Kaggle webpage

In one piped statement:

1. read in data
2. convert char to factor vars
3. rename all colnames lowercase
4. order cols by name: alphabetically
5. order cols by datatype: nominal, then numeric

Get Data

a = read_csv(here::here('/Clustering/Mall_Customers.csv')) %>%  #1
  mutate(across(where(is.character),as.factor)) %>% #2
  clean_names(.) %>% #3
  select(sort(tidyselect::peek_vars())) %>% #4
  select(where(is.factor), where(is.numeric)) %>%  #5
  select(-customer_id)

#Split Data

set.seed(321)
split = a %>% initial_split()
train = split %>% training()
test = split %>% testing()

EDA: nom vars

check head rows

train %>% select(where(is.factor)) %>% head %>% DT::datatable()

glimpse structure

train %>% select(where(is.factor)) %>% glimpse

Rows: 150
Columns: 1
$ gender <fct> Male, Male, Female, Female, Female, Female, Female, Male, Female, Male, Female, Female...

check for missing values

train %>% select(where(is.factor)) %>% miss_var_summary()

distribution: counts of unique levels

sapply(train %>% select(where(is.factor)), n_unique)

gender 
     2 

reference: names of unique levels

sapply(train %>% select(where(is.factor)), unique)

     gender  
[1,] "Male"  
[2,] "Female"

binarize gender to numeric var

train = train %>% mutate(gender = if_else(gender == 'Male', 1, 0))

distribution: viz

ggplotly(
train %>% count(gender = factor(gender)) %>%
  mutate(percent = n/nrow(train)) %>%
  ggplot(aes(percent, gender, fill = gender)) +
  geom_col() +
  scale_x_continuous(labels = scales::percent) +
  labs(x = '', y = '', title ='Gender Percent Breakdown: 1 = Male, 0 = Female') +
  theme(legend.position = 'none')
)

EDA: num vars

check head rows

train %>% select(where(is.numeric)) %>% head %>% DT::datatable()

glimpse structure

train %>% select(where(is.numeric)) %>% glimpse

Rows: 150
Columns: 4
$ gender               <dbl> 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, ...
$ age                  <dbl> 19, 21, 20, 31, 22, 35, 23, 64, 30, 67, 35, 24, 37, 22, 52, 35, 35, 25, ...
$ annual_income_k      <dbl> 15, 15, 16, 17, 17, 18, 18, 19, 19, 19, 19, 20, 20, 20, 23, 23, 24, 24, ...
$ spending_score_1_100 <dbl> 39, 81, 6, 40, 76, 6, 94, 3, 72, 14, 99, 77, 13, 79, 29, 98, 35, 73, 73,...

check for missing values

miss_var_summary(train %>% select(where(is.numeric)))

NA

distribution: viz

There appears to be outliers for male annual income

distribution: viz

distribution: viz

pairwise correlations: viz

GGally::ggcorr(train %>% select(where(is.numeric)), low = '#990000', mid = '#E0E0E0', high = '#009900', label = TRUE)

Preprocessing

Reference: (package recipes)[https://recipes.tidymodels.org/reference/index.html]

normalize data

Create matrix

Determine Optimal Number of Clusters

Documentation

1) silhouette analysis with kmeans and euclidean distancing

factoextra::fviz_nbclust(
  train.matrix,
  diss = dist(train.matrix, method = "euclidean"),
  FUNcluster=kmeans,
  method="silhouette"
  ) +
  theme_classic()

2) silhouette analysis with kmeans and manhattan distancing

factoextra::fviz_nbclust(
  train.matrix,
  diss = dist(train.matrix, method = "manhattan"),
  FUNcluster=cluster::pam,
  method="silhouette"
  ) +
  theme_classic()

3) silhouette analysis with pam and euclidean distancing

factoextra::fviz_nbclust(
  train.matrix,
  diss = dist(train.matrix, method = "euclidean"),
  FUNcluster=kmeans,
  method="silhouette"
  ) +
  theme_classic()

4) silhouette analysis with pam and manhattan distancing

factoextra::fviz_nbclust(
  train.matrix,
  diss = dist(train.matrix, method = "manhattan"),
  FUNcluster=cluster::pam,
  method="silhouette"
  ) +
  theme_classic()

Finalize Models with Optimal Number of Clusters and Distancing Method

Kmeans

km = eclust(
  train.matrix,
  FUNcluster="kmeans",
  k=9,
  hc_metric = "manhattan"
  )

PAM

pam = eclust(
  train.matrix,
  FUNcluster="pam",
  k=9,
  hc_metric = "manhattan"
  )

train %>%
  mutate(gender = factor(if_else(gender == 1, 'Male', 'Female'))) %>%
  group_by(cluster, gender) %>%
  summarise(
    mean.age = mean(age, na.rm = TRUE),
    mean.income = mean(annual_income_k, na.rm = TRUE),
    mean.spending.score = mean(spending_score_1_100, na.rm = TRUE)
  )

`summarise()` regrouping output by 'cluster' (override with `.groups` argument)

xvars = train %>% select(-cluster) %>% names %>% as.character()

jpal = colorRampPalette(RColorBrewer::brewer.pal(8,'Dark2'))(25)

train %>% plot_ly(y = ~cluster, x = ~eval(as.name(xvars[2])), color = ~cluster, colors = jpal) %>% add_boxplot() %>% hide_legend() %>% layout(
  title = paste0(xvars[2],' by cluster'), xaxis = list(title = xvars[2]))

train %>% plot_ly(y = ~cluster, x = ~eval(as.name(xvars[3])), color = ~cluster, colors = jpal) %>% add_boxplot() %>% hide_legend() %>% layout(
  title = paste0(xvars[3],' by cluster'), xaxis = list(title = xvars[3]))

train %>% plot_ly(y = ~cluster, x = ~eval(as.name(xvars[4])), color = ~cluster, colors = jpal) %>% add_boxplot() %>% hide_legend() %>% layout(
  title = paste0(xvars[4],' by cluster'), xaxis = list(title = xvars[4]))

Notes

1. Try Other Popular Clustering Methods
   • hierarchical clustering
   • dbscan